home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / rotate1a / rotatesq.frm next >
Text File  |  1999-09-10  |  6KB  |  175 lines
  1. VERSION 5.00
  2. Begin VB.Form Form1 
  3.    BackColor       =   &H80000007&
  4.    Caption         =   "RotateSquare ⌐ oigres P"
  5.    ClientHeight    =   3195
  6.    ClientLeft      =   60
  7.    ClientTop       =   345
  8.    ClientWidth     =   4680
  9.    ClipControls    =   0   'False
  10.    LinkTopic       =   "Form1"
  11.    ScaleHeight     =   213
  12.    ScaleMode       =   3  'Pixel
  13.    ScaleWidth      =   312
  14.    StartUpPosition =   3  'Windows Default
  15.    Begin VB.Timer Timer1 
  16.       Interval        =   10
  17.       Left            =   360
  18.       Top             =   1920
  19.    End
  20.    Begin VB.Line Line1 
  21.       BorderColor     =   &H00C0FFFF&
  22.       BorderWidth     =   5
  23.       Index           =   3
  24.       X1              =   192
  25.       X2              =   72
  26.       Y1              =   48
  27.       Y2              =   72
  28.    End
  29.    Begin VB.Line Line1 
  30.       BorderColor     =   &H00FF0000&
  31.       BorderWidth     =   5
  32.       Index           =   2
  33.       X1              =   152
  34.       X2              =   80
  35.       Y1              =   160
  36.       Y2              =   80
  37.    End
  38.    Begin VB.Line Line1 
  39.       BorderColor     =   &H0000FF00&
  40.       BorderWidth     =   5
  41.       Index           =   1
  42.       X1              =   248
  43.       X2              =   144
  44.       Y1              =   136
  45.       Y2              =   160
  46.    End
  47.    Begin VB.Line Line1 
  48.       BorderColor     =   &H000000FF&
  49.       BorderWidth     =   5
  50.       Index           =   0
  51.       X1              =   192
  52.       X2              =   248
  53.       Y1              =   48
  54.       Y2              =   128
  55.    End
  56. End
  57. Attribute VB_Name = "Form1"
  58. Attribute VB_GlobalNameSpace = False
  59. Attribute VB_Creatable = False
  60. Attribute VB_PredeclaredId = True
  61. Attribute VB_Exposed = False
  62. 'RotateRectangle ⌐ oigres P
  63. 'Email: oigres@postmaster.co.uk
  64. 'indented by indenter5 from www.BMSLtd.co.uk
  65. Private Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As POINTAPI, ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long
  66. Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
  67. Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
  68.  
  69. Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Long) As Long
  70. Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
  71. Private Const ALTERNATE = 1
  72. Private Const WINDING = 2
  73. Private Const RGN_AND = 1
  74. Private Const RGN_COPY = 5
  75. Private Const RGN_DIFF = 4
  76. Private Const RGN_OR = 2
  77. Private Const RGN_XOR = 3
  78.  
  79. Dim x, y
  80. Private Type pt
  81.     X1 As Variant
  82.     Y1 As Variant
  83.     X2 As Variant
  84.     Y2 As Variant
  85.     X3 As Variant
  86.     Y3 As Variant
  87.     X4 As Variant
  88.     Y4 As Variant
  89. End Type
  90. Private Type POINTAPI
  91.     x As Long
  92.     y As Long
  93. End Type
  94. 'Dim ptarray(3) As pt
  95. 'Dim store(3) As pt
  96.  
  97. Dim prgn(3) As POINTAPI 'rgn array
  98. Dim temp, hrgn1, hrgn2, hrgn3 As Long 'handles to rgns
  99.  
  100. Private Sub Form_KeyPress(KeyAscii As Integer)
  101.     'return to exit program
  102.     If KeyAscii = 13 Then End
  103. End Sub
  104.  
  105. Private Sub sqlines()
  106.     Static degree, radians
  107.     Static add
  108.     Static radius
  109.     'algorithm: get a point in a circle and offset 3
  110.     'other points by 90 degrees
  111.     'radians = (degree / 180) * 3.14
  112.     'radius of circle
  113.     If radius > 100 Then add = -2
  114.     If radius < 5 Then add = 2
  115.  
  116.     radius = radius + add
  117.  
  118.     degree = IIf(degree < 360, degree + 2, 0)
  119.     degrad = (degree / 180) * 3.14 'radian convertion
  120.     Index = 0
  121.     degrad2 = 0
  122.     cntrfx = Form1.ScaleWidth \ 2
  123.     cntrfy = Form1.ScaleHeight \ 2
  124.     'clockwise rotation; setup first point of sqr
  125.     x = radius * Cos(degrad + degrad2) + radius * Sin(degrad + degrad2) + cntrfx
  126.     y = radius * Sin(degrad + degrad2) - radius * Cos(degrad + degrad2) + cntrfy
  127.     Line1(Index).X1 = x - 2 '        line shape for effect
  128.     Line1(Index).Y1 = y - 25
  129.     stx = x: sty = y 'store start x ,y
  130.     prgn(Index).x = x: prgn(Index).y = y 'array for rgn
  131.     'CurrentX = x: CurrentY = y
  132.     For offset = 90 To 270 Step 90 ' 90,180,270 corner offsets
  133.         degrad2 = (offset / 180) * 3.14 'offset to radians
  134.         x = radius * Cos(degrad + degrad2) + radius * Sin(degrad + degrad2) + cntrfx
  135.         y = radius * Sin(degrad + degrad2) - radius * Cos(degrad + degrad2) + cntrfy
  136.  
  137.         Line1(Index).X2 = x - 2 '
  138.         Line1(Index).Y2 = y - 25
  139.         prgn(Index).x = x: prgn(Index).y = y
  140.         'Form1.Line -(x, y), &HFFFFFF
  141.         'Line1(Index).X1 = x
  142.         'Line1(Index).Y1 = y
  143.         Index = Index + 1
  144.         '
  145.         Line1(Index).X1 = x - 2
  146.         Line1(Index).Y1 = y - 25
  147.         'Debug.Print Index
  148.     Next offset
  149.     prgn(3).x = stx: prgn(3).y = sty
  150.     Line1(Index).X2 = stx - 2
  151.     Line1(Index).Y2 = sty - 25
  152.     'Form1.Line -(stx, sty)
  153.     'erase window rgn , set to 0 to make the system discard ownership
  154.     'Hint from p430 of Delphi2 developers guide by Xavier Pacheco and Steve Teixeira
  155.     success = SetWindowRgn(Form1.hWnd, 0&, True)
  156.  
  157.     If hrgn1 <> 0 Then
  158.         success = DeleteObject(hrgn1)
  159.         success = DeleteObject(hrgn2)
  160.         success = DeleteObject(hrgn3)
  161.     End If
  162.     hrgn1 = CreatePolygonRgn(prgn(0), 4, WINDING) 'rotating square
  163.     hrgn2 = CreateRectRgn(0, 0, Form1.ScaleWidth + 10, Form1.ScaleHeight + 40)
  164.     '               cut out square out of big window rgn
  165.     hrgn3 = CombineRgn(hrgn1, hrgn1, hrgn2, RGN_XOR)
  166.     success = SetWindowRgn(Form1.hWnd, hrgn1, True) 'set new rgn to form
  167.  
  168.     DoEvents
  169.     'Wend
  170. End Sub
  171.  
  172. Private Sub Timer1_Timer()
  173.     sqlines
  174. End Sub
  175.